home *** CD-ROM | disk | FTP | other *** search
/ PC Format (UK) 75 / PC Format 75 - Nov 1997.iso / delpac / PAC.~PA < prev    next >
Text File  |  1997-08-11  |  16KB  |  658 lines
  1. {
  2.  
  3. Maze Game
  4.  
  5. John Kennedy 5/8/97
  6.  
  7. Featuring use of sprites, reading the keyboard,
  8. and anything else which springs to mind. Should
  9. feature sound as well and animation too if I could
  10. be bothered...
  11.  
  12. }
  13.  
  14.  
  15. unit Pac;
  16.  
  17. interface
  18.  
  19. uses
  20.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  21.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons;
  22.  
  23. type
  24.   TForm1 = class(TForm)
  25.     Up: TBitBtn;
  26.     Timer1: TTimer;
  27.     down: TButton;
  28.     Left: TButton;
  29.     Right: TButton;
  30.     ScoreText: TLabel;
  31.     LivesText: TLabel;
  32.     Hightext: TLabel;
  33.     procedure Timer1Timer(Sender: TObject);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure FormPaint(Sender: TObject);
  36.     procedure downClick(Sender: TObject);
  37.     procedure UpClick(Sender: TObject);
  38.     procedure LeftClick(Sender: TObject);
  39.     procedure RightClick(Sender: TObject);
  40.   private
  41.     { Private declarations }
  42.   public
  43.     { Public declarations }
  44.   end;
  45.  
  46. var
  47.   Form1: TForm1;
  48.   x,y,dx,dy:integer;
  49.   x1,y1,dx1,dy1:integer;
  50.   OriginalBitMap: TBitmap; {Stores the maze graphics as new }
  51.   StoreBitMap: TBitmap; {Stores the maze graphics }
  52.   BufferBitMap: TBitmap; { draw here when working stuff out }
  53.   GhostBitmap: TBitmap;  { Store the pacman }
  54.   GhostMaskBitmap: TBitmap;  { Store the pacman mask}
  55.   PacBitmap: TBitmap;  { Store the pacman }
  56.   PacMaskBitmap: TBitmap;  { Store the pacman mask}
  57.   PillBitmap: TBitmap;  { Store the pill graphic }
  58.   PillMaskBitmap: TBitmap;  { Store the pill mask}
  59.  
  60.   maze: array[1..13] of string;
  61.   pills: array[1..13] of string;
  62.   ghostx: array[1..4] of integer;
  63.   ghosty: array[1..4] of integer;
  64.   ghostdir: array[1..4] of integer;
  65.   pac_x,pac_y,pac_dir,next_pac_dir:integer;
  66.   last_offset:integer;
  67.   score,high,lives: integer;
  68.  
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74.  
  75. procedure UpdateGhost (nx,ny,ox,oy,ghost_dir:integer);
  76. var
  77. fromrect,torect,newrect:TRect;
  78. offset:integer;
  79.  
  80.  
  81. {
  82.  
  83. This is our sprite routine. It copies a graphic to
  84. the screen without destroying what's underneath or
  85. the surroundings.
  86.  
  87. 1. Copy the underlying graphic to the buffer
  88. 2. Combine the mask with the buffer (AND)
  89. 3. Combine the graphic with the buffer (OR)
  90. 4. Copy the buffer to the screen.
  91.  
  92. Now, to erase the graphic we can simply copy the
  93. background from the store to the screen, or at
  94. least the portion which needs it. However, this
  95. tends to cause flickering.
  96.  
  97. Instead, when we move the graphic, we calculate
  98. the total shape which needs to be copied in order
  99. to both draw the new position AND erase the old
  100. position. This is cunning: it means we don't need
  101. a separate erase routine and it reduces flicker.
  102.  
  103. We use a Delphi function to caclulate the "union"
  104. between two rectangles -- the old sprite position,
  105. and the new one. This gives us the rectangle to
  106. work with. Neat, huh?
  107.  
  108. }
  109.  
  110.  
  111. begin
  112.  
  113. {
  114.  1. Restore where it was from Store to Buffer
  115.  2. Create new image in the Buffer
  116.  3. Combine these two rectangles
  117.  4. Draw new position (which erases old) onto screen
  118. }
  119.  
  120.  
  121. case ghost_dir of
  122. 2: offset:=0;
  123. 8: offset:=32;
  124. 4:offset:=64;
  125. 1:offset:=96
  126. end;
  127.  
  128. { Copy from store to buffer }
  129.  
  130. fromrect  := Rect(ox,oy,ox+31,oy+31);
  131. torect := Rect(ox,oy,ox+31,oy+31);
  132. BufferBitmap.Canvas.CopyMode := cmSrcCopy;
  133. BufferBitmap.Canvas.CopyRect(torect,StoreBitmap.canvas, fromrect);
  134.  
  135. { AND the buffer and the mask }
  136.  
  137. fromrect  := Rect(0,0,31,31);
  138. torect := Rect(nx,ny,nx+31,ny+31);
  139. BufferBitmap.Canvas.CopyMode := cmSrcAnd;
  140. BufferBitmap.Canvas.CopyRect(torect,GhostMaskBitmap.canvas, fromrect);
  141.  
  142. { OR the buffer and the graphic }
  143.  
  144. fromrect  := Rect(offset,0,offset+31,31);
  145. BufferBitmap.Canvas.CopyMode := cmSrcPaint;
  146. BufferBitmap.Canvas.CopyRect(torect,GhostBitmap.canvas, fromrect);
  147.  
  148. { Calculate the entire area (old/new) to copy to screen }
  149.  
  150. fromrect := Rect(ox,oy,ox+31,oy+31);
  151. torect :=  Rect(nx,ny,nx+31,ny+31);
  152. UnionRect(newrect,fromrect,torect);
  153.  
  154. { Copy it to the screen }
  155.  
  156. Form1.Canvas.CopyMode := cmSrcCopy;
  157. Form1.Canvas.CopyRect(newrect,BufferBitmap.canvas, newrect);
  158.  
  159. end;
  160.  
  161.  
  162.  
  163. procedure DrawPill (x,y:integer);
  164. var
  165. fromrect,torect:TRect;
  166. begin
  167.  
  168. x:=(x*32)-16;
  169. y:=(y*32)-16;
  170.  
  171. { Like a miniature sprite routine, except of course
  172.  that pills don't move }
  173.  
  174.  
  175.  
  176. torect := Rect(x,y,x+24,y+24);
  177. fromrect := Rect(0,0,24,24);
  178.  
  179. BufferBitmap.Canvas.CopyMode := cmSrcCopy;
  180. BufferBitmap.Canvas.CopyRect(torect,StoreBitmap.canvas,torect);
  181.  
  182. BufferBitmap.Canvas.CopyMode := cmSrcAnd;
  183. BufferBitmap.Canvas.CopyRect(torect,PillMaskBitmap.canvas,fromrect);
  184.  
  185. BufferBitmap.Canvas.CopyMode := cmSrcPaint;
  186. BufferBitmap.Canvas.CopyRect(torect,PillBitmap.canvas,fromrect);
  187.  
  188. StoreBitmap.Canvas.CopyMode := cmSrcCopy;
  189. StoreBitmap.Canvas.CopyRect(torect,BufferBitmap.canvas,torect);
  190.  
  191. end;
  192.  
  193.  
  194. procedure ErasePill (x,y:integer);
  195. var
  196. therect:TRect;
  197. begin
  198.  
  199. x:=(x*32)-16;
  200. y:=(y*32)-16;
  201.  
  202. therect := Rect(x,y,x+24,y+24);
  203.  
  204. StoreBitmap.Canvas.CopyMode := cmSrcCopy;
  205. StoreBitmap.Canvas.CopyRect(therect,OriginalBitmap.canvas,therect);
  206.  
  207. end;
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217. procedure UpdatePac (nx,ny,ox,oy:integer);
  218. var
  219. fromrect,torect,newrect:TRect;
  220. offset:integer;
  221.  
  222. begin
  223.  
  224. {
  225.  Locate start of pacman graphic in bitmap.
  226.  Slight complication here: the pacman has four positions,
  227.  and they are all stored in the one bitmap. However, as
  228.  I created the bitmap, I know exactly where the positions
  229.  are -- they are all 32 pixels across. We can therefore use
  230.  this case/of function to assign the start position to the
  231.  variable called offset. We also need to
  232.  make sure the correct mask is used too!
  233. }
  234.  
  235. case pac_dir of
  236. 0: offset:=last_offset;
  237. 2: offset:=0;
  238. 8: offset:=32;
  239. 4:offset:=64;
  240. 1:offset:=96
  241. end;
  242.  
  243. last_offset:=offset;
  244.  
  245. fromrect  := Rect(ox,oy,ox+31,oy+31);
  246. torect := Rect(ox,oy,ox+31,oy+31);
  247. BufferBitmap.Canvas.CopyMode := cmSrcCopy;
  248. BufferBitmap.Canvas.CopyRect(torect,StoreBitmap.canvas, fromrect);
  249.  
  250.  
  251. fromrect  := Rect(offset,0,offset+31,31);
  252. torect := Rect(nx,ny,nx+31,ny+31);
  253. BufferBitmap.Canvas.CopyMode := cmSrcAnd;
  254. BufferBitmap.Canvas.CopyRect(torect,PacMaskBitmap.canvas, fromrect);
  255.  
  256.  
  257. BufferBitmap.Canvas.CopyMode := cmSrcPaint;
  258. BufferBitmap.Canvas.CopyRect(torect,PacBitmap.canvas, fromrect);
  259.  
  260. fromrect := Rect(ox,oy,ox+31,oy+31);
  261. torect :=  Rect(nx,ny,nx+31,ny+31);
  262. UnionRect(newrect,fromrect,torect);
  263.  
  264. Form1.Canvas.CopyMode := cmSrcCopy;
  265. Form1.Canvas.CopyRect(newrect,BufferBitmap.canvas, newrect);
  266.  
  267. end;
  268.  
  269.  
  270.  
  271.  
  272. procedure MoveGhost(var ghost_x,ghost_y,ghost_dir:integer);
  273. var
  274. xx,yy,gx,gy:integer;
  275. dir: char;
  276. newway,free:integer;
  277. testrect,pacrect,ghostrect: trect;
  278. Begin
  279.  
  280.  
  281. { Oooh, horrible! Trying to make an intelligent ghost is
  282. very difficult. Here I settle for making sure the ghost is
  283. not moving anywhere it shouldn't. Everytime we come to a junction
  284. (we can tell because we have a special array too look at -- it's
  285. entirely separate from the graphics) it decides randomly to move,
  286. or moves if it has to. It does not back-up the way it came, and
  287. as there are no dead-ends in the maze, this is perfectly ok.
  288. Remember this if you design your own maze! }
  289.  
  290.  
  291. xx:=ghost_x;yy:=ghost_y;
  292.  
  293. case ghost_dir of
  294. 1: ghost_y:=ghost_y-4;
  295. 2: ghost_x:=ghost_x+4;
  296. 4: ghost_y:=ghost_y+4;
  297. 8: ghost_x:=ghost_x-4;
  298. end;
  299.  
  300. UpdateGhost(ghost_x,ghost_y,xx,yy,ghost_dir);
  301.  
  302. pacrect:=Rect(pac_x,pac_y,pac_x+31,pac_y+31);
  303. ghostrect:=Rect(ghost_x,ghost_y,ghost_x+31,ghost_y+31);
  304. if (intersectrect(testrect,pacrect,ghostrect)<>0) then
  305.    Form1.canvas.textout(10,200,'Dead!');
  306.  
  307. { Yes, well, ran out of time at this point. I'm sure you
  308. can write your own getting killed routine }
  309.  
  310.  
  311.  
  312. if ((ghost_x-16) mod 32 = 0) and ((ghost_y-16) mod 32 = 0)  then
  313. begin
  314. { At a maze junction }
  315.  
  316.   gx:=1+(ghost_x-16) div 32;
  317.   gy:=1+(ghost_y-16) div 32;
  318.   dir:=maze[gy][gx];
  319.   free:=strtoint('$'+dir);
  320.  
  321.   if ((free and ghost_dir) = 0) or (random(10)<5) then
  322.   begin
  323.        { Cannot carry on in current direction, get a new one }
  324.  
  325.        repeat
  326.  
  327.        { Repeat until a random direction is found which is both legal,
  328.        and not back the way it came. That's what the ghost_dir plus newway
  329.        tests are about : it's a bit of a hack, but says four conditions }
  330.  
  331.        case random(4) of
  332.        0: newway:=1;
  333.        1: newway:=2;
  334.        2: newway:=4;
  335.        3: newway:=8;
  336.        end;
  337.  
  338.        until ((free and newway) <>0) and ((ghost_dir + newway) <>5) and ((ghost_dir + newway) <>10);
  339.  
  340.        ghost_dir := newway;
  341.  
  342.  
  343.  
  344.   end;
  345.  
  346. end;
  347.  
  348. end;
  349.  
  350.  
  351.  
  352. procedure MovePac;
  353. var
  354. xx,yy,px,py:integer;
  355. dir: char;
  356. newway,free:integer;
  357. Begin
  358.  
  359. { This is easier -- it's up to the player to
  360. move the thing. We just wait until we get to
  361. a junction, and see if we need to change the
  362. direction }
  363.  
  364.  
  365. xx:=pac_x;yy:=pac_y;
  366.  
  367. case pac_dir of
  368. 1: pac_y:=pac_y-4;
  369. 2: pac_x:=pac_x+4;
  370. 4: pac_y:=pac_y+4;
  371. 8: pac_x:=pac_x-4;
  372. end;
  373.  
  374. UpdatePac(pac_x,pac_y,xx,yy);
  375.  
  376.  
  377. if ((pac_x-16) mod 32 = 0) and ((pac_y-16) mod 32 = 0)  then
  378. begin
  379. { At a maze junction }
  380.  
  381.  
  382.  
  383. px:=1+(pac_x-16) div 32;
  384. py:=1+(pac_y-16) div 32;
  385.  
  386.  
  387. dir:=maze[py][px];
  388. free:=strtoint('$'+dir);
  389.  
  390.  
  391.  
  392. { If the next_pac_dir and free are in agreement, change
  393.  
  394. If they are not, check that the pac_dir and free are ok
  395.  
  396. If they are not, stop the Pacman. }
  397.  
  398. if (next_pac_dir and free) <>0 then pac_dir:=next_pac_dir
  399. else if (pac_dir and free) = 0 then pac_dir:=0;
  400.  
  401.  
  402. { Check for pills }
  403.  
  404. if (pills[py][px]='*') then
  405. begin
  406.  pills[py][px]:=' ';
  407.  ErasePill(px,py);
  408.  score:=score+10
  409.  end;
  410.  
  411. end;
  412.  
  413. end;
  414.  
  415.  
  416.  
  417.  
  418. procedure TForm1.Timer1Timer(Sender: TObject);
  419. var
  420. i:integer;
  421. begin
  422.  
  423. { This is the heart of the game. Every tick of the
  424. clock, we move the ghosts, move the player and
  425. update the score. }
  426.  
  427.  
  428. for i:=1 to 4 do
  429.     MoveGhost(ghostx[i],ghosty[i],ghostdir[i]);
  430.  
  431. MovePac;
  432.  
  433. ScoreText.caption:='Score:'+inttostr(score);
  434.  
  435. end;
  436.  
  437.  
  438.  
  439.  
  440. procedure TForm1.FormCreate(Sender: TObject);
  441. var
  442. i:integer;
  443. begin
  444.  
  445. { This procedure is called when the games starts,
  446. because Delphi always calls it when a form is
  447. created. This gives us a perfect opportunity to
  448. sort out all the things that need doing once,
  449. such as defining and loading graphics, and
  450. defining the special array which contains a
  451. map of the maze. }
  452.  
  453.  
  454. Randomize;
  455.  
  456. StoreBitmap := TBitmap.Create;
  457. StoreBitmap.LoadFromFile('c:\sprite\grid5.bmp');
  458.  
  459. OriginalBitmap := TBitmap.Create;
  460. OriginalBitmap.LoadFromFile('c:\sprite\grid5.bmp');
  461.  
  462. BufferBitmap := TBitmap.Create;
  463. BufferBitmap.LoadFromFile('c:\sprite\grid5.bmp');
  464.  
  465. PacBitmap := TBitmap.Create;
  466. PacBitmap.LoadFromFile('c:\sprite\newpac.bmp');
  467.  
  468. PacMaskBitmap := TBitmap.Create;
  469. PacMaskBitmap.LoadFromFile('c:\sprite\newpmask.bmp');
  470.  
  471. GhostBitmap := TBitmap.Create;
  472. GhostBitmap.LoadFromFile('c:\sprite\ghost.bmp');
  473.  
  474. GhostMaskBitmap := TBitmap.Create;
  475. GhostMaskBitmap.LoadFromFile('c:\sprite\gostmask.bmp');
  476.  
  477.  
  478. PillBitmap := TBitmap.Create;
  479. PillBitmap.LoadFromFile('c:\sprite\dot.bmp');
  480.  
  481. PillMaskBitmap := TBitmap.Create;
  482. PillMaskBitmap.LoadFromFile('c:\sprite\dotmask.bmp');
  483.  
  484. pac_x:=16+(32*7);
  485. pac_y:=16+(32*8);
  486. pac_dir:=0;
  487. next_pac_dir:=0;
  488. score:=0;
  489. high:=0;
  490. lives:=3;
  491.  
  492. for i:=1 to 4 do
  493. begin
  494.      ghostdir[i]:=2;
  495.      ghostx[i]:=16;
  496.      ghosty[i]:=16;
  497. end;
  498.  
  499. { Now, this is tricky. This is a map of the maze, one letter/number
  500. for every junction. It tells the ghosts and player which ways they can
  501. go. Here's how the letter/number is defined. Using
  502.  
  503. 1=Up, 2=Right, 4=Down, 8=Left
  504.  
  505. add up all the directions which are possible. As this adds up to
  506. a maximum of 15 for all directions, make this hexidecimal to
  507. take up only one characted. This makes is an F.  }
  508.  
  509.  
  510.  maze[1]:='6AEAAAEAAEAAEAAAEAC';
  511.  maze[2]:='5050005005005000505';
  512.  maze[3]:='5050005005005000505';
  513.  maze[4]:='5050005005005000505';
  514.  maze[5]:='7ABAEAFAABAAFAEABAD';
  515.  maze[6]:='5000505000005050005';
  516.  maze[7]:='7AAAD07AEAEAD07AAAD';
  517.  maze[8]:='5000505050505050005';
  518.  maze[9]:='7AAABAFABABAFABAAAD';
  519. maze[10]:='5000005000005000005';
  520. maze[11]:='7AAAC07AEAEAD06AAAD';
  521. maze[12]:='5000505050505050005';
  522. maze[13]:='3AAABABA903ABABAAA9';
  523.  
  524. end;
  525.  
  526.  
  527.  
  528. procedure TForm1.FormPaint(Sender: TObject);
  529.  
  530. var
  531. fromrect,torect:TRect;
  532. i,j:integer;
  533.  
  534. begin
  535.  
  536. { This procedure is called whenever Delphi wants to draw
  537. or update the contents of the form. This means at the very
  538. start, so we can include code here which draws the maze.
  539.  
  540. Drawing the maze is really a matter of copying the graphics
  541. from the Store to the visible bitmap. There is one extra trick:
  542. the pills are drawn into the store bitmap to start with, and
  543. erased from it using yet another bitmap to store the original,
  544. virgin maze. }
  545.  
  546.  
  547.  
  548. { Draw in pills }
  549.  
  550. for i:=1 to 13 do
  551.     for j:=1 to 19 do
  552.         if (maze[i][j]<>'0') then
  553.            begin
  554.                 DrawPill(j,i);
  555.                 pills[i][j]:='*';
  556.            end;
  557.  
  558. fromrect  := Rect(0,0,399,299);
  559. torect := Rect(50,20,50+399,20+299);
  560.  
  561. Form1.Canvas.CopyMode := cmSrcCopy;
  562. Form1.Canvas.CopyRect(Rect(0,0,639,479), StoreBitmap.Canvas, Rect(0,0,639,479));
  563.  
  564.  
  565.  
  566. end;
  567.  
  568.  
  569.  
  570.  
  571. { These procedures happen when the buttons are pressed. Buttons?
  572. Yes, there are four -- one for every direction. They just don't appear
  573. on the screen, but we use the fact that Delphi allows hotkeys to make
  574. it possible to steer the pacman. Yes, yet more cunning.  }
  575.  
  576. procedure TForm1.downClick(Sender: TObject);
  577. begin
  578. { Try to move down }
  579. if (pac_dir=1) then pac_dir:=4;
  580. next_pac_dir:=4;
  581. end;
  582.  
  583. procedure TForm1.UpClick(Sender: TObject);
  584. begin
  585. { Try to move up }
  586. if (pac_dir=4) then pac_dir:=1;
  587. next_pac_dir:=1;
  588. end;
  589.  
  590. procedure TForm1.LeftClick(Sender: TObject);
  591. begin
  592. { Try to go left }
  593. if (pac_dir=2) then pac_dir:=8;
  594. next_pac_dir:=8;
  595. end;
  596.  
  597. procedure TForm1.RightClick(Sender: TObject);
  598. begin
  599. { Try to go right }
  600.  
  601. if (pac_dir=8) then pac_dir:=2;
  602. next_pac_dir:=2;
  603.  
  604.  
  605. end;
  606.  
  607. end.
  608.  
  609. {
  610.  
  611.  And that's it! the End!
  612.  
  613.  
  614.  I hope you enjoyed our little jaunt with Delphi. I hope you
  615.  can see that it's a very powerful programming language,
  616.  and is capable of almost everything. Yes, it's a database
  617.  language, but it's a whole lot more besides. You can control
  618.  multimedia files and create huge and reliable projects of
  619.  professional quality. And even better, this was free! To
  620.  my mind, this has been the best magazine give-away ever: a
  621.  full, honest to goodness PC development suite. Heck, you could
  622.  write a killer program and become rich with this. Hmm, now
  623.  that sounds a good idea... I have my eye on a new motorbike...
  624.  
  625.  I've certainly found it an eye-opener when it comes to programming
  626.  the PC, as it hides all the messy stuff and lets you get on with it.
  627.  In fact, I'm almost tempted to rush out and buy the full version of
  628.  the latest v3 release (gasp! magazine writer buys software shocker!)
  629.  because it's faster and will let me use DirectX. There is also a
  630.  games creation library available which makes it even easier.
  631.  
  632.  I'll put a link to this on my home web site. Please pay it a
  633.  visit if you want to ask a question, or find a link to other
  634.  sites where you'll find information from people who actually
  635.  know what they are talking about. My web site address is most
  636.  definitely here at:
  637.  
  638.  http://freespace.virgin.net/john.kennedy
  639.  
  640.  Appologies once again for the wrong addresses which have
  641.  sneaked out. It was all my fault entirely, and I can only
  642.  grovel for your forgiveness.
  643.  
  644.  So, the end is really here. Thanks to all who have emailed
  645.  and visited the web site. I'll try and put up the previous
  646.  tutorials, copyright permitting, and any more hints and tips.
  647.  
  648.  Take my advice and get programming. I want to see your games
  649.  and applications appearing on the PC Format coverdisk. There
  650.  just aren't enough home-grown, bedroom, DIY programmers. With
  651.  Delphi, you have no excuse (other than not understanding the
  652.  tutorials of course) so get to it! Program! Program! Program!
  653.  
  654.  John
  655.  10/7/98
  656.  
  657. }
  658.